(*
This file is part of the utils section of Lustre reader

* Copyright (c) 2010, Nicola Camuffo.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*     * Redistributions of source code must retain the above copyright
*       notice, this list of conditions and the following disclaimer.
*     * Redistributions in binary form must reproduce the above copyright
*       notice, this list of conditions and the following disclaimer in the
*       documentation and/or other materials provided with the distribution.
*     * Neither the name of Nicola Camuffo, nor the
*       names of its contributors may be used to endorse or promote products
*       derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ''AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)


open Prfuncs
open Lustypes



let sout = output_string
let iout h x = output_string h (string_of_int x) 
let cr h = sout h "\n"

let sconstr = print_simple_constructor
let cconstr = print_complex_constructor

let slist = print_simple_list
let clist = print_complex_list



let rec print_type handle spaces tp = 
  let ind = spaces ^ "  " in

  match tp with
		T_TOCHECK -> sout handle (spaces ^ "T_TOCHECK")
		
		| T_INT -> sout handle (spaces ^ "T_INT")
    | T_REAL -> sout handle (spaces ^ "T_REAL")
    | T_BOOL -> sout handle (spaces ^ "T_BOOL")
		
    | T_TUPLE(tl) ->
      let f h x = print_type h ind x in
      let pr h = clist h spaces tl f in
      cconstr handle spaces "T_TUPLE" pr
		| T_ARRAY(t,e) ->
			let f h = print_type h ind t in
			let g h = print_expression h ind e in
			let pr h = f h; cr h; g h in
			cconstr handle spaces "T_ARRAY" pr
		| T_STRUCT(tl) ->
      let f h x = sout h ind; sout h (fst x); cr h; print_type h ind (snd x) in
      let pr h = clist h spaces tl f in
      cconstr handle spaces "T_STRUCT" pr
    | T_ENUM(sl) ->
      let f h x = sout h x in
      let pr h = slist h spaces sl f in
      sconstr handle spaces "T_LIST" pr
    | T_LIST(tl) ->
      let f h x = print_type h ind x in
      let pr h = clist h spaces tl f in
      cconstr handle spaces "T_LIST" pr
			
    | T_NAMED(id) ->
      let pr h = iout h id in
      sconstr handle spaces "T_LIST" pr

and print_expression handle spaces (ex,tp) =
  let ind = spaces ^ "  " in

	let print ex = match ex with
    E_BOOL(x) ->
			let pr h = sout h (string_of_bool x) in
			sconstr handle spaces "E_BOOL" pr
		| E_INT(x) ->
			let pr h = iout h x in
			sconstr handle spaces "E_INT" pr
		| E_REAL(x) ->
			let pr h = sout h (string_of_float x) in
			sconstr handle spaces "E_REAL" pr

		| E_VAR(id) ->
			let pr h = iout h id in 
			sconstr handle spaces "E_VAR" pr
		| E_CONST(id) ->
			let pr h = iout h id in 
			sconstr handle spaces "E_CONST" pr
		| E_NODE(id,el) ->
			let f h x = print_expression h ind x in
			let pr h = clist h spaces el f in
			cconstr handle spaces "E_NODE" (fun h -> iout h id; cr h; pr h)

		| E_AND(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_AND" pr
		| E_OR(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_OR" pr
		| E_IMPL(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_IMPL" pr
		| E_XOR(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_XOR" pr
		| E_NOT(e) ->
			let pr h = print_expression h ind e in
			cconstr handle spaces "E_NOT" pr

		| E_ITE(e1,e2,e3) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2; cr h; print_expression h ind e3 in
			cconstr handle spaces "E_ITE" pr

		| E_EQ(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_EQ" pr
		| E_NEQ(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_NEQ" pr
		| E_LT(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_LT" pr
		| E_GT(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_GT" pr
		| E_LTE(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_LTE" pr
		| E_GTE(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_GTE" pr

		| E_PLUS(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_PLUS" pr
		| E_MINUS(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_MINUS" pr
		| E_MULT(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_MULT" pr
		| E_DIV(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_DIV" pr
		| E_INTDIV(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_INTDIV" pr
		| E_MOD(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_MOD" pr
		| E_UMINUS(e) ->
			let pr h = print_expression h ind e in
			cconstr handle spaces "E_UMINUS" pr

		| E_NOR(el) ->
			let f h x = print_expression h ind x in
			let pr h = clist h spaces el f in
			cconstr handle spaces "E_NOR" pr
		| E_EXCL(el) ->
			let f h x = print_expression h ind x in
			let pr h = clist h spaces el f in
			cconstr handle spaces "E_EXCL" pr

		| E_PRE(e) ->
			let pr h = print_expression h ind e in
			cconstr handle spaces "E_PRE" pr
		| E_FOLLOWEDBY(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
			cconstr handle spaces "E_FOLLOWEDBY" pr

		| E_STRUCT(el) ->
      let f h x = sout h ind; sout h (fst x); cr h; print_expression h ind (snd x) in
      let pr h = clist h spaces el f in
      cconstr handle spaces "E_STRUCT" pr
		| E_TUPLE(el) ->
      let f h x = print_expression h ind x in
      let pr h = clist h spaces el f in
      cconstr handle spaces "E_TUPLE" pr
		| E_LIST(el) ->
      let f h x = print_expression h ind x in
      let pr h = clist h spaces el f in
      cconstr handle spaces "E_LIST" pr
		| E_ARRAY(e1,e2) ->
			let pr h = print_expression h ind e1; cr h; print_expression h ind e2 in
      cconstr handle spaces "E_ARRAY" pr

		| E_STRUCTSEL(e,s) ->
			let pr h = print_expression h ind e; cr h; sout h (ind^s) in
			cconstr handle spaces "E_STRUCTSEL" pr
		| E_TUPLESEL(e,e1,e2,e3) ->
			let pr h = print_expression h ind e; cr h; print_expression h ind e1; cr h; print_expression h ind e2; cr h; print_expression h ind e3 in
			cconstr handle spaces "E_TUPLESEL" pr
		| E_ENUMSEL(id,s) ->
			let pr h = iout h id; sout h (","^s) in
			sconstr handle spaces "E_BOOL" pr

	in
	print ex; sout handle ":"; cr handle; print_type handle spaces tp
	
		
and print_lhs handle spaces (lhs,tp) =
  let ind = spaces ^ "  " in

  let print lhs = match lhs with
		L_VAR(id) ->
			let pr h = iout h id in 
			sconstr handle spaces "L_VAR" pr

		| L_STRUCTSEL(x,s) ->
			let pr h = print_lhs h ind x; cr h; sout h (ind^s) in
			cconstr handle spaces "L_STRUCTSEL" pr
		| L_TUPLESEL(x,e1,e2,e3) ->
			let pr h = print_lhs h ind x; cr h; print_expression h ind e1; cr h; print_expression h ind e2; cr h; print_expression h ind e3 in
			cconstr handle spaces "L_TUPLESEL" pr
		| L_LIST(xl) ->
			let f h x = print_lhs h ind x in
			let pr h = clist h spaces xl f in
			cconstr handle spaces "L_LIST" pr
			
	in
	print lhs; sout handle ":"; cr handle; print_type handle spaces tp

	

(*
(*
  | E_FBY(e1,i,e2) ->
    let pr h = print_expression h ind e1; out h "\n"; out h ind; out h (string_of_int i); out h "\n"; print_expression h ind e2 in
    cconstr handle spaces "E_FBY" pr
*)


(*
  | E_COERCE_TO_INT(e1) ->
    let pr h = print_expression h ind e1 in
    cconstr handle spaces "E_COERCE_TO_INT" pr
  | E_COERCE_TO_REAL(e1) ->
    let pr h = print_expression h ind e1 in
    cconstr handle spaces "E_COERCE_TO_REAL" pr
*)


  | E_RECORD(e1) ->
    let f h x = out h ind; out h (fst x); out h "\n"; print_expression h ind (snd x); out h "\n" in
    let pr h = List.iter (f h) e1 in
    cconstr handle spaces "E_RECORD" pr
  | E_TUPLE(e1) ->
    let f h x = print_expression h ind x; out h "\n" in
    let pr h = List.iter (f h) e1 in
    cconstr handle spaces "E_TUPLE" pr
(*
  | E_RECORDFIELD(e1,fieldname) ->
    let pr h = print_expression h ind e1; out h "\n"; out h ind; out h fieldname in
    cconstr handle spaces "E_RECORDFIELD" pr
  | E_TUPLEFIELD(e1,index) ->
    let pr h = print_expression h ind e1; out h "\n"; out h ind; out h (string_of_int index) in
    cconstr handle spaces "E_TUPLEFIELD" pr
  | E_SLICE(e1,n1,n2,st) ->
    let pr h = print_expression h ind e1; out h "\n"; out h ind; out h (string_of_int n1); out h "\n"; out h ind; out h (string_of_int n2) in 
    cconstr handle spaces "E_SLICE" pr
*)
(*
  | E_CURRENT(e1) ->
    let pr h = print_expression h ind e1 in
    cconstr handle spaces "E_CURRENT" pr
*)

  | E_NODE(nid,el) ->
    let prl h e = print_expression h ind e; out h "\n" in
    let pr h = out h ind; out h (string_of_int nid); out h "\n"; List.iter (prl h) el in
    cconstr handle spaces "E_NODE" pr
  | E_OUTVAR(ex,id) ->
    let pr h = print_expression h ind ex; out h "\n"; out h ind; out h (string_of_int id) in
    cconstr handle spaces "E_OUTVAR" pr
  | E_LIST(el) ->
    let pr h = List.iter (fun e -> print_expression h ind e; out h "\n") el in
    cconstr handle spaces "E_LIST" pr

(*

  | E_CONDACT(e1,e2,e3,s4) -> 
    let pr h = print_expression h ind e1; out h "\n"; print_expression h ind e2; out h "\n"; print_expression h ind e3; out h "\n"; print_expression h ind s4 in
    cconstr handle spaces "E_NODE" pr

  | E_ATMOSTONE(_) ->
  | E_WHEN(_,_) ->
  | E_COERCE_TO_BOOL(e1) ->
*)
*)



(*
let rec print_lhs handle spaces lhs =
  let ind = spaces ^ "   " in
  
  match lhs with
    SIMPLE(s) ->
      let pr h = out h s in
      sconstr handle spaces "SIMPLE" pr
    | TUPFIELD(x,n) ->
      let pr h = print_lhs h ind x; out h "\n"; out h ind; out h (string_of_int n) in
      cconstr handle spaces "TUPFIELD" pr
    | ARRSLICE(x,n1,n2) ->
      let pr h = print_lhs h ind x; out h "\n"; out h ind; out h (string_of_int n1); out h ind; out h (string_of_int n2) in
      cconstr handle spaces "ARRSLICE" pr
    | RECFIELD(x,s) ->
      let pr h = print_lhs h ind x; out h "\n"; out h ind; out h s in
      cconstr handle spaces "RECFIELD" pr
    | LIST(l) ->
      let prl h x = print_lhs h ind x; out h "\n" in
      let pr h = List.iter (prl h) l in
      cconstr handle spaces "LIST" pr
*)
